home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / tkwizard.tcl < prev    next >
Encoding:
Text File  |  2004-02-21  |  35.7 KB  |  1,092 lines
  1. # Copyright (c) 2001, Bryan Oakley
  2. # All Rights Reservered
  3. #
  4. # Bryan Oakley
  5. # oakley_at_bardo.clearlight.com
  6. #
  7. # tkwizard 1.0a1
  8. #
  9. # this code is freely distributable without restriction, and is 
  10. # provided as-is with no warranty expressed or implied. 
  11. #
  12.  
  13. package require Tk 8.0
  14. package provide tkwizard 1.0
  15.  
  16. # create the package namespace, and do some basic initialization
  17. namespace eval tkwizard {
  18.  
  19.     namespace export tkwizard
  20.     
  21.     set ns [namespace current]
  22.  
  23.     # define class bindings
  24.     bind Wizard <<WizHelp>>     [list ${ns}::handleEvent %W <<WizHelp>>]
  25.     bind Wizard <<WizNextStep>> [list ${ns}::handleEvent %W <<WizNextStep>>]
  26.     bind Wizard <<WizPrevStep>> [list ${ns}::handleEvent %W <<WizPrevStep>>]
  27.     bind Wizard <<WizCancel>>   [list ${ns}::handleEvent %W <<WizCancel>>]
  28.     bind Wizard <<WizFinish>>   [list ${ns}::handleEvent %W <<WizFinish>>]
  29.  
  30.     # create a default image
  31.     image create photo [namespace current]::feather -data {
  32.        R0lGODlhIAAgALMAANnZ2QAAwAAA/wBAwAAAAICAgAAAgGBggKCgpMDAwP//
  33.        /////////////////////yH5BAEAAAAALAAAAAAgACAAAAT/EMhJq60hhHDv
  34.        pVCQYohAIJBzFgpKoSAEAYcUIRAI5JSFlkJBCGLAMYYIIRAI5ASFFiqDgENK
  35.        EUIwBAI5ywRlyhAEHFKKEEIgEMgJyiwUBAGHnCKEEAyBQM4yy5RhCDikFDBI
  36.        SSCQExRKwxBDjAGHgEFKQyCQk9YgxBBjDAGDnAQCOWkNQgwxxDgwyGkIBHJS
  37.        GoQQYohRYJDTEAjkpDWIIYQQBQY5A4FATlqDEEIMgWCQMxgCgZy0BiikRDDI
  38.        GQyBQE5aAxRSIhjkNIRAICetAQop04BBTgOBnLTKIIQQacAgZzAQyEkrCEII
  39.        kQYMckoDgZy0giCESAMGOaWBQMoydeeUQYhUYJBTGgikLHNOGYRACQY5pYFA
  40.        yjLnnEGgNGCQMxgAACgFAjnpFEUNGOQ0BgI5Z6FUFlVgkJNAICctlMqiyggB
  41.        BkMIBHLOUiidSUEiJwRyzlIopbJQSilFURJUIJCTVntlKhhjCwsEctJqr0wF
  42.        Y0xhBAA7
  43.     }
  44.  
  45.     # Make a class binding to do some housekeeping
  46.     bind Wizard <Destroy> [list ${ns}::wizard-destroy %W]
  47. }
  48.  
  49. # usage: tkwizard ?-showhelp boolean? ?-title string? 
  50. proc tkwizard::tkwizard {name args} {
  51.  
  52.     set showHelp 0
  53.     set body {}
  54.  
  55.     set i 0
  56.     while {$i < [llength $args]} {
  57.         set arg [lindex $args $i]
  58.         switch -glob -- $arg {
  59.             -showhelp {
  60.                 incr i
  61.                 set showHelp [lindex $args $i]
  62.             }
  63.             -title {
  64.                 incr i
  65.                 set title [lindex $args $i]
  66.             }
  67.             default {
  68.                 return -code error "unknown option \"$arg\" (!)"
  69.             }
  70.         }
  71.         incr i
  72.     }
  73.             
  74.     if {![info exists title]} {set title $name}
  75.  
  76.     init $name $showHelp $title
  77.  
  78.     return $name
  79. }
  80.  
  81. ##
  82. # wizard-destroy
  83. #
  84. # does cleanup of the wizard when it is destroyed. Specifically,
  85. # it destroys the associated namespace
  86. # 
  87. proc tkwizard::wizard-destroy {name} {
  88.  
  89.     upvar #0 [namespace current]::@$name-state wizState
  90.  
  91.     if {![info exists wizState]} {
  92.         return -code error "unknown wizard \"$name\""
  93.     }
  94.     set w $wizState(window)
  95.     interp alias {} $wizState(alias) {}
  96.     catch {namespace delete $wizState(namespace)} message
  97.  
  98.     return ""
  99. }
  100.  
  101.  
  102. # intended for an end user to draw a step for the purpose
  103. # of measuring it's size. Not fully realized yet; it seems to 
  104. # put the wizard in a slightly weird state
  105. proc tkwizard::wizProx-drawstep {name stepname} {
  106.  
  107.     upvar #0 [namespace current]::@$name-state wizState
  108.     upvar #0 [namespace current]::@$name-config wizConfig
  109.     upvar #0 [namespace current]::@$name-stepData wizStepData
  110.  
  111.     # First, build the appropriate layout...
  112.     set layout $wizStepData($stepname,layout)
  113.     buildLayout $name $layout
  114.  
  115.     # then build the step...
  116.     set wizConfig(-step) $stepname
  117.     buildStep $name $stepname
  118. }
  119.  
  120. ##
  121. # 
  122. proc tkwizard::wizProc-cget {name args} {
  123.     upvar #0 [namespace current]::@$name-config wizConfig
  124.  
  125.     if {[llength $args] != 1} {
  126.         return -code error "wrong \# args: should be \"$name cget option\""
  127.     }
  128.     set option [lindex $args 0]
  129.     if {[info exists wizConfig($option)]} {
  130.         return $wizConfig($option)
  131.     } 
  132.     return -code error "unknown option \"$option\""
  133. }
  134.  
  135. proc tkwizard::wizProc-configure {name args} {
  136.     upvar #0 [namespace current]::@$name-config wizConfig
  137.  
  138.     if {[llength $args] == 0} {
  139.         set result [list]
  140.         foreach item [lsort [array names wizConfig]] {
  141.             lappend result $item $wizConfig($item)
  142.         }
  143.         return $result
  144.  
  145.     } elseif {[llength $args] == 1} {
  146.         uplevel $name cget [lindex $args 0]
  147.  
  148.     } else {
  149.         foreach {option value} $args {
  150.             if {![info exists wizConfig($option)]} {
  151.                 return -code error "unknown option \"$option\""
  152.             }
  153.             set wizConfig($option) $value
  154.             switch -exact -- $option {
  155.                 -background {
  156.                     $wizConfig(toplevel) configure -background $value
  157.                     # in theory we should step through all widgets,
  158.                     # changing their color as well. Maybe I generate
  159.                     # a virtual event like <<WizConfigure>> so the
  160.                     # programmer can reconfigure their steps appropriately
  161.                 }
  162.                 -title {
  163.                     wm title $w $value
  164.                 }
  165.             }
  166.         }
  167.     }
  168. }
  169.  
  170. ##
  171. # wizProc
  172. #
  173. # this is the procedure that represents the wizard object; each
  174. # wizard will be aliased to this proc; the wizard name will be
  175. # provided as the first argument (this is transparent to the caller)
  176.  
  177. proc tkwizard::wizProc {name command args} {
  178.     # define the state variable here; that way the worker procs
  179.     # can do an uplevel to access the variable with a simple name
  180.     variable @$name-state
  181.  
  182.     # call the worker proc
  183.     eval wizProc-$command $name $args
  184. }
  185.  
  186. ##
  187. # wizProc-hide
  188. #
  189. # usage: wizHandle hide
  190. #
  191. # hides the wizard without destroying it. Note that state is NOT
  192. # guaranteed to be preserved, since a subsequent "show" will reset
  193. # the state. 
  194.  
  195. proc tkwizard::wizProc-hide {name args} {
  196.     upvar #0 [namespace current]::@$name-state wizState
  197.  
  198.     wm withdraw $wizState(window)
  199. }
  200.  
  201. ##
  202. # wizProc-order
  203. #
  204. # usage: wizHandle order ?-nocomplain? ?step step ...?
  205. #
  206. # example: wizHandle order step1 step2 step3 finalStep
  207. #
  208. # unless -nocomplain is specified, will throw an error if
  209. # a nonexistent step is given, or if a duplicate step is
  210. # given.
  211. #
  212. # without any steps, will return the current order
  213.  
  214. proc tkwizard::wizProc-order {name args} {
  215.     upvar #0 [namespace current]::@$name-state wizState
  216.  
  217.     set i [lsearch -exact $args "-nocomplain"]
  218.     set complain 1
  219.  
  220.     if {$i >= 0} {
  221.         set complain 0
  222.         set args [lreplace $args $i $i]
  223.     }
  224.  
  225.     if {$complain} {
  226.         # make sure all of the steps are defined.  "defined" means
  227.         # there is a initialize proc for that step. We also need to
  228.         # make sure we don't have the same step represented twice.
  229.         # This is inefficient, but speed isn't particularly critical
  230.         # here
  231.         array set found [list]
  232.         foreach step $args {
  233.             set tmp [info commands $wizState(namespace)::initialize-$step]
  234.             if {[llength $tmp] != 1} {
  235.                 return -code error "unknown step \"$step\""
  236.             }
  237.             if {[info exists found($step)]} {
  238.                 return -code error "duplicate step \"$step\""
  239.             }
  240.             set found($step) 1
  241.         }
  242.     }
  243.  
  244.     if {[llength $args] == 0} {
  245.         return $wizState(steps)
  246.     } else {
  247.         set wizState(steps) $args
  248.     }
  249. }
  250.  
  251. ##
  252. # wizProc-step
  253. #
  254. # implements the "step" method of the wizard object. The body
  255. # argument is code that will be run when the step identified by
  256. # 'stepName' is to be displayed in the wizard
  257. #
  258. # usage: wizHandle step stepName ?-layout layout? body
  259. #
  260.  
  261. proc tkwizard::wizProc-step {name stepName args} {
  262.  
  263.     upvar #0 [namespace current]::@$name-state wizState
  264.     upvar #0 [namespace current]::@$name-stepData wizStepData
  265.  
  266.     set body [lindex $args end]
  267.     set args [lreplace $args end end]
  268. #    set args [lrange $args 0 end-1]
  269.  
  270.     set layout "basic"
  271.     set i [lsearch -exact $args {-layout}]
  272.     if {$i >= 0} {
  273.         set j [expr {$i + 1}]
  274.         set layout [lindex $args $j]
  275.         if {[llength [info commands [namespace current]::buildLayout-$layout]] == 0} {
  276.             return -code error "unknown layout \"$layout\""
  277.         }
  278.         set args [lreplace $args $i $j]
  279.     }
  280.     set wizStepData($stepName,layout) $layout
  281.  
  282.     lappend wizState(steps) $stepName
  283.  
  284.     set procname "[namespace current]::${name}::initialize-$stepName"
  285.     proc $procname {} "[list set this $name];\n$body"
  286. }
  287.  
  288. ##
  289. # wizProc-widget
  290. #
  291. # Returns the path to an internal widget, or executes the
  292. # an internal widget command
  293. #
  294. # usage: wizHandle widget widgetName ?args?
  295. #
  296. # if [llength $args] > 0 it will run the widget command with
  297. # the args. Otherwise it will return the widget path
  298.  
  299. proc tkwizard::wizProc-widget {name args} {
  300.     upvar #0 [namespace current]::@$name-state wizState
  301.  
  302.     if {[llength $args] == 0} {
  303.         # return a list of all widget names
  304.         set result [list]
  305.         foreach item [array names wizState widget,*] {
  306.             regsub {widget,} $item {} item
  307.             lappend result $item
  308.         }
  309.         return $result
  310.     }
  311.  
  312.     set widgetname [lindex $args 0]
  313.     set args [lrange $args 1 end]
  314.  
  315.     if {![info exists wizState(widget,$widgetname)]} {
  316.         return -code error "unknown widget: \"$widgetname\""
  317.     }
  318.  
  319.     if {[llength $args] == 0} {
  320.         return $wizState(widget,$widgetname)
  321.     }
  322.  
  323.     # execute the widget command
  324.     eval [list $wizState(widget,$widgetname)] $args
  325. }
  326.  
  327. ##
  328. # wizProc-info
  329. #
  330. # Returns the information in the state array
  331. # 
  332. # usage: wizHandle info
  333.  
  334. proc tkwizard::wizProc-info {name args} {
  335.  
  336.     if {[llength $args] > 0} {
  337.         return -code error "wrong \# args: should be \"$name info\""
  338.     } 
  339.     upvar #0 [namespace current]::@$name-state wizState
  340.  
  341.     foreach item [lsort [array names wizState]] {
  342.         puts "$item = $wizState($item)"
  343.     }
  344. }
  345.  
  346. # return the namespace of the wizard
  347. proc tkwizard::wizProc-namespace {name} {
  348.     set ns [namespace current]::${name}
  349.     return $ns
  350. }
  351.  
  352. # execute the code in the namespace of the wizard
  353. proc tkwizard::wizProc-eval {name code} {
  354.     set ns [namespace current]::${name}
  355.     namespace eval $ns $code
  356. }
  357.     
  358. ##
  359. # wizProc-show
  360. # 
  361. # Causes the wizard to be displayed in it's initial state
  362. #
  363. # usage: wizHandle show
  364. #
  365. # This is where all of the widgets are created, though eventually
  366. # I'll probably move the widget drawing to a utility proc...
  367.  
  368. proc tkwizard::wizProc-show {name args} {
  369.  
  370.     upvar #0 [namespace current]::@$name-state wizState
  371.     upvar #0 [namespace current]::@$name-config wizConfig
  372.  
  373.     # initialize the remainder of the wizard state
  374.     set wizState(history)         [list]
  375.     set wizConfig(-previousstep)  ""
  376.     set wizConfig(-nextstep)      ""
  377.  
  378.     set steps $wizState(steps)
  379.     if {[llength $steps] == 0} {
  380.         # no steps? Just show it as-is.
  381.         wm deiconify $name
  382.         return
  383.     }
  384.  
  385.     # set a trace on where we store the next state. The trace
  386.     # will cause the next and previous buttons to become
  387.     # enabled or disabled. Thus, within a step a programmer can
  388.     # decide when to enable or disable the buttons by merely 
  389.     # setting these variables.
  390.     set code [namespace code "varTrace [list $name]"]
  391.     set stateVar "[namespace current]::@$name-config"
  392.     foreach item {-previousstep -nextstep -state -complete} {
  393.         trace vdelete  ${stateVar}($item) wu $code
  394.         trace variable ${stateVar}($item) wu $code
  395.     }
  396.  
  397.     # show the first step
  398.     set wizState(history) [lindex $steps 0]
  399.     showStep $name 
  400.  
  401.     # make it so, Number One
  402.     update idletasks
  403.     wm deiconify $wizState(window)
  404.  
  405.     # This makes sure closing the window with the window manager control
  406.     # Does The Right Thing (now if only I could figure out what the
  407.     # Right Thing is...)
  408.     wm protocol $name WM_DELETE_WINDOW \
  409.         [list $wizState(widget,cancelButton) invoke]
  410.  
  411.     return ""
  412. }
  413.  
  414. # This gets called whenever certain parts of our state variable
  415. # get set or unset (presently this only happens with -nextstep 
  416. # and -previousstep)
  417. proc tkwizard::varTrace {name varname index op} {
  418.     upvar #0 [namespace current]::@$name-state wizState
  419.     upvar #0 [namespace current]::@$name-config wizConfig
  420.  
  421.     catch {
  422.         switch -- $index {
  423.             -state {
  424.                 set state $wizConfig(-state)
  425.                 if {[string equal $state "normal"]} {
  426. #                    $name configure -cursor {}
  427.                     if {[string length $wizConfig(-previousstep)] == 0} {
  428.                         $wizState(widget,backButton) configure -state disabled
  429.                     } else {
  430.                         $wizState(widget,backButton) configure -state normal
  431.                     }
  432.                     if {[string length $wizConfig(-nextstep)] == 0} {
  433.                         $wizState(widget,nextButton) configure -state disabled
  434.                     } else {
  435.                         $wizState(widget,nextButton) configure -state normal
  436.                     }
  437.                     if {$wizConfig(-complete)} {
  438.                         $wizState(widget,finishButton) configure -state normal
  439.                     } else {
  440.                         $wizState(widget,finishButton) configure -state disabled
  441.                     }
  442.  
  443.                 } else {
  444.  #                    $name configure -cursor watch
  445.                     $wizState(widget,cancelButton) configure -cursor left_ptr
  446.                     $wizState(widget,nextButton)   configure -state disabled
  447.                     $wizState(widget,backButton)   configure -state disabled
  448.                     $wizState(widget,helpButton)   configure -state disabled
  449.                     $wizState(widget,finishButton) configure -state disabled
  450.                 }
  451.             }
  452.             -complete {
  453.                 if {$wizConfig(-complete)} {
  454.                     $wizState(widget,finishButton) configure -state normal
  455.                 } else {
  456.                     $wizState(widget,finishButton) configure -state disabled
  457.                 }
  458.             }
  459.  
  460.             -previousstep {
  461.                 set state normal
  462.                 if {[string length $wizConfig(-previousstep)] == 0} {
  463.                     set state disabled
  464.                 }
  465.                 $wizState(widget,backButton) configure -state $state
  466.             }
  467.             -nextstep {
  468.                 set state normal
  469.                 if {[string length $wizConfig(-nextstep)] == 0} {
  470.                     set state disabled
  471.                 }
  472.                 $wizState(widget,nextButton) configure -state $state
  473.             }
  474.  
  475.             default {
  476.                 puts "bogus variable trace: name=$varname index=$index op=$op"
  477.             }
  478.         }
  479.     }
  480. }
  481.  
  482. # Causes a step to be built by clearing out the current contents of
  483. # the client window and then executing the initialization code for
  484. # the given step
  485.  
  486. proc tkwizard::buildStep {name step}  {
  487.     upvar #0 [namespace current]::@$name-state wizState
  488.  
  489.     # reset the state of the windows in the wizard
  490.     eval destroy [winfo children $wizState(widget,clientArea)]
  491. #    wizProc-stepconfigure $name -title "" -subtitle "" -pretext "" -posttext ""
  492.  
  493.     namespace eval $wizState(namespace) initialize-$step 
  494.  
  495. }
  496.  
  497.  
  498. # This block of code is common to all wizard actions. 
  499. # (ie: it is the target of the -command option for wizard buttons)
  500. proc tkwizard::cmd {command name} {
  501.  
  502.     upvar #0 [namespace current]::@$name-state wizState
  503.     upvar #0 [namespace current]::@$name-config wizConfig
  504.  
  505.     switch $command {
  506.         Help       {event generate $name <<WizHelp>>}
  507.         Next       {event generate $name <<WizNextStep>>}
  508.         Previous   {event generate $name <<WizPrevStep>>}
  509.         Finish     {event generate $name <<WizFinish>>}
  510.         Cancel     {event generate $name <<WizCancel>>}
  511.  
  512.         default {
  513.             puts "'$command' not implemented yet"
  514.         }
  515.     }
  516. }
  517.  
  518. proc tkwizard::handleEvent {name event} {
  519.  
  520.     upvar #0 [namespace current]::@$name-state wizState
  521.     upvar #0 [namespace current]::@$name-config wizConfig
  522.     upvar #0 [namespace current]::@$name-stepData wizStepData
  523.  
  524.     switch $event {
  525.         <<WizHelp>> {
  526.             # not implemented yet
  527.         }
  528.  
  529.         <<WizNextStep>> {
  530.             set thisStep [lindex $wizState(history) end]
  531.             lappend wizState(history) $wizConfig(-nextstep)
  532.             showStep $name 
  533.         }
  534.  
  535.         <<WizPrevStep>> {
  536.  
  537.             # pop an item off of the history
  538.             set p [expr {[llength $wizState(history)] -2}]
  539.             set wizState(history) [lrange $wizState(history) 0 $p]
  540.             showStep $name 
  541.         }
  542.  
  543.         <<WizFinish>> {
  544.  
  545.             set thisStep [lindex $wizState(history) end]
  546.             wizProc-hide $name
  547.         }
  548.  
  549.         <<WizCancel>> {
  550.  
  551.             wizProc-hide $name
  552.         }
  553.  
  554.         default {
  555.             puts "'$event' not implemented yet"
  556.         }
  557.     }
  558. }
  559.  
  560. proc tkwizard::showStep {name} {
  561.  
  562.     upvar #0 [namespace current]::@$name-state wizState
  563.     upvar #0 [namespace current]::@$name-config wizConfig
  564.     upvar #0 [namespace current]::@$name-stepData wizStepData
  565.  
  566.     # the step is whatever is at the tail end of our 
  567.     # history
  568.     set step [lindex $wizState(history) end]
  569.     set proc "initialize-$step"
  570.     set wizConfig(-step) $step
  571.  
  572.     set layout $wizStepData($step,layout)
  573.  
  574.     # First, build the appropriate layout...
  575.     buildLayout $name $layout
  576.  
  577.     # then build the step...
  578.     set steps $wizState(steps)
  579.     set lastStep [expr {[llength $steps] -1}]
  580.     set stepIndex [lsearch $steps $step]
  581.     set prevIndex [expr {$stepIndex -1}]
  582.     set nextIndex [expr {$stepIndex + 1}]
  583.  
  584.     # initialize the next, previous and current step configuration
  585.     # options; this will set the state of the next/previous buttons.
  586.     # note that the user can retrieve these values with the normal
  587.     # 'cget' and 'configure' methods
  588.     set p [expr {[llength $wizState(history)] -2}]
  589.     set wizConfig(-previousstep) [lindex $wizState(history) $p]
  590.     set wizConfig(-nextstep) [lindex $steps $nextIndex]
  591.  
  592.     if {$stepIndex == ([llength $steps]-1)} {
  593.         set wizConfig(-complete) 1
  594.     } else {
  595.         set wizConfig(-complete) 0
  596.     }
  597.  
  598.     buildStep $name $step
  599.  
  600. }
  601.  
  602.  
  603. proc tkwizard::init {name showHelp title} {
  604.  
  605.     # name should be a widget path
  606.     set w $name
  607.  
  608.     # create variables in this namespace to keep track
  609.     # of the state of this wizard. We do this here to 
  610.     # avoid polluting the namespace of the widget. We'll
  611.     # create local aliases for the variables to make the
  612.     # code easier to read and write
  613.  
  614.     # this variable contains state information about the 
  615.     # wizard, such as the wizard title, the name of the 
  616.     # window and namespace associated with the wizard, the
  617.     # list of steps, and so on.
  618.     variable "@$name-state"
  619.     upvar \#0 [namespace current]::@$name-state wizState
  620.  
  621.     # this variable contains all of the parameters associated
  622.     # with the wizard and settable with the "configure" method
  623.     variable "@name-config"
  624.     upvar \#0 [namespace current]::@$name-config wizConfig
  625.  
  626.     # this is an experimental array containing data of known
  627.     # step types. Presently not being used.
  628.     variable "@name-stepTypes"
  629.     upvar \#0 [namespace current]::@$name-stepTypes wizStepTypes
  630.  
  631.     # this contains step-specific data, such as the step title
  632.     # and subtitle, icon, etc. All elements are unset prior to
  633.     # rendering a given step. It is each step's responsibility
  634.     # to set it appropriately, and it is each step type's 
  635.     # responsibility to use the data.
  636.     variable "@name-stepData"
  637.     upvar \#0 [namespace current]::@$name-stepData  wizStepData
  638.  
  639.     # do some state initialization; more will come later when
  640.     # the wizard is actually built
  641.     set wizConfig(-complete)      0
  642.     set wizConfig(-state)         normal
  643.     set wizConfig(-title)         $title
  644.     set wizConfig(-nextstep)      ""
  645.     set wizConfig(-previousstep)  ""
  646.     set wizConfig(-step)          ""
  647.     set wizConfig(-showhelp)      $showHelp
  648.  
  649.     set wizState(title)        $title
  650.     set wizState(window)       $w
  651.     set wizState(steps)        [list]
  652.     set wizState(namespace)    [namespace current]::$name
  653.     set wizState(name)         $name
  654.     set wizState(toplevel)     {}
  655.  
  656.     # create the wizard (except for the step pages...)
  657.     buildDialog $name
  658.  
  659.     # this establishes a namespace for this wizard; this namespace
  660.     # will contain wizard-specific data managed by the creator of
  661.     # the wizard
  662.     namespace eval $name {}
  663.  
  664.     # this creates the instance command by first renaming the widget
  665.     # command associated with our toplevel, then making an alias 
  666.     # to our own command
  667.     set wizState(toplevel) $wizState(namespace)::originalWidgetCommand
  668.     rename $w $wizState(toplevel)
  669.     interp alias {} ::$w {} [namespace current]::wizProc $name
  670.     set wizState(alias) ::$w
  671.  
  672.     # set some useful configuration values
  673.     set wizConfig(-background) \
  674.         [$wizState(namespace)::originalWidgetCommand cget -background]
  675. }
  676.  
  677. proc tkwizard::buildDialog {name} {
  678.     # This is custom for Getleft
  679.     global labelButtons
  680.  
  681.     upvar #0 [namespace current]::@$name-state wizState
  682.     upvar #0 [namespace current]::@$name-config wizConfig
  683.  
  684.     set prefix [string trimright $wizState(window) .]
  685.  
  686.     set wizState(widget,topframe)     $prefix.topframe
  687.     set wizState(widget,sep1)         $prefix.sep1
  688.     set wizState(widget,sep2)         $prefix.sep2
  689.     set wizState(widget,buttonFrame)  $prefix.buttonFrame
  690.     set wizState(widget,helpButton)   $prefix.buttonFrame.helpButton
  691.     set wizState(widget,nextButton)   $prefix.buttonFrame.nextButton
  692.     set wizState(widget,backButton)   $prefix.buttonFrame.backButton
  693.     set wizState(widget,cancelButton) $prefix.buttonFrame.cancelButton
  694.     set wizState(widget,finishButton) $prefix.buttonFrame.finishButton
  695.     set wizState(widget,layoutFrame)  $prefix.layoutFrame
  696.  
  697.     # create the toplevel window
  698.     set w $wizState(window)
  699.     toplevel $w -class Wizard -bd 2 -relief groove
  700.     wm title $w $wizConfig(-title)
  701.     wm withdraw $w
  702.     wm resizable $w 0 0
  703.  
  704.     # the dialog is composed of two areas: the row of buttons and the
  705.     # area with the dynamic content. To make it look the way we want it to
  706.     # we'll use another frame for a visual separator
  707.     frame $wizState(widget,buttonFrame) -bd 0 
  708.     frame $wizState(widget,layoutFrame) -bd 0
  709.     frame $wizState(widget,sep1) -class WizSeparator -height 2 -bd 2 -relief groove
  710.  
  711.     pack $wizState(widget,buttonFrame) -side bottom -fill x
  712.     pack $wizState(widget,sep1)  -side bottom -fill x
  713.     pack $wizState(widget,layoutFrame) -side top -fill both -expand y
  714.  
  715.     # make all of the buttons
  716.     button $wizState(widget,helpButton) \
  717.         -text "What's This?" \
  718.         -default normal \
  719.         -bd 1 \
  720.         -relief raised \
  721.         -command [namespace code "cmd Help [list $name]"]
  722.  
  723.     button $wizState(widget,backButton) \
  724.         -textvariable labelButtons(back) \
  725.         -default normal \
  726.         -width 9 \
  727.         -bd 1 \
  728.         -relief raised \
  729.         -command [namespace code "cmd Previous [list $name]"]
  730.  
  731.     button $wizState(widget,nextButton) \
  732.         -textvariable labelButtons(next) \
  733.         -default normal \
  734.         -width 9 \
  735.         -bd 1 \
  736.         -relief raised \
  737.         -command [namespace code "cmd Next [list $name]"]
  738.  
  739.     button $wizState(widget,finishButton) \
  740.         -textvariable labelButtons(finish) \
  741.         -default normal \
  742.         -width 9 \
  743.         -bd 1 \
  744.         -relief raised \
  745.         -command [namespace code "cmd Finish [list $name]"]
  746.  
  747.     button $wizState(widget,cancelButton) \
  748.         -textvariable labelButtons(cancel)   \
  749.         -default normal \
  750.         -width 9 \
  751.         -bd 1  \
  752.         -relief raised \
  753.         -command [namespace code "cmd Cancel [list $name]"]
  754.  
  755.     # pack the buttons
  756.     if {$wizConfig(-showhelp)} {
  757.         pack $wizState(widget,helpButton) -side left -padx 4 -pady 8
  758.     }
  759.     pack $wizState(widget,cancelButton) -side right -padx 4 -pady 8
  760.     pack $wizState(widget,finishButton) -side right -pady 8 -padx 4
  761.     pack $wizState(widget,nextButton) -side right -pady 8
  762.     pack $wizState(widget,backButton) -side right -pady 8
  763.  
  764.     # return the name of the toplevel, for lack of a better idea...
  765.     return $wizState(window)
  766. }
  767.  
  768. proc tkwizard::buildLayout {name layoutName} {
  769.     upvar #0 [namespace current]::@$name-state wizState
  770.     upvar #0 [namespace current]::@$name-config wizConfig
  771.  
  772.     set w $wizState(window)
  773.     set lf $wizState(widget,layoutFrame)
  774.  
  775.     # initialize the layout variables
  776.     initLayout-$layoutName $name
  777.  
  778.     # if the layout hasn't actually been built yet, build it
  779.     if {![winfo exists $lf.$layoutName]} {
  780.         buildLayout-$layoutName $name
  781.     }
  782.     eval pack forget [winfo children $lf]
  783.     pack $lf.$layoutName -side top -fill both -expand y
  784.  
  785. }
  786.  
  787. # this is a user-callable interface to configureLayout-<layout>
  788. proc tkwizard::wizProc-stepconfigure {name args} {
  789.     upvar #0 [namespace current]::@$name-state wizState
  790.     upvar #0 [namespace current]::@$name-config wizConfig
  791.     upvar #0 [namespace current]::@$name-stepData wizStepData
  792.  
  793.     set step $wizConfig(-step)
  794.     set layout $wizStepData($step,layout)
  795.     eval configureLayout-$layout $name $args
  796. }
  797.  
  798.  
  799. # this defines the widget paths. Will be called each time we
  800. # switch layouts
  801. proc tkwizard::initLayout-basic {name} {
  802.     upvar #0 [namespace current]::@$name-state wizState
  803.     upvar #0 [namespace current]::@$name-config wizConfig
  804.  
  805.     set layout $wizState(widget,layoutFrame).basic
  806.  
  807.     set wizState(widget,clientArea)   $layout.clientArea
  808.     set wizState(widget,icon)         $layout.icon
  809.     set wizState(widget,title)        $layout.title
  810.     set wizState(widget,subtitle)     $layout.subtitle
  811.     set wizState(widget,pretext)      $layout.pretext
  812.     set wizState(widget,posttext)     $layout.posttext
  813.  
  814. }
  815.  
  816. proc tkwizard::buildLayout-basic {name} {
  817.     upvar #0 [namespace current]::@$name-state wizState
  818.     upvar #0 [namespace current]::@$name-config wizConfig
  819.  
  820.     set layout $wizState(widget,layoutFrame).basic
  821.     frame $layout -class WizLayoutBasic
  822.  
  823.     # using the option database saves me from hard-coding it for
  824.     # every widget. I guess I'm just lazy.
  825.     option add *WizLayoutBasic*Label.justify             left interactive
  826.     option add *WizLayoutBasic*Label.anchor              nw   interactive
  827.     option add *WizLayoutBasic*Label.highlightThickness  0    interactive
  828.     option add *WizLayoutBasic*Label.borderWidth         0    interactive
  829.     option add *WizLayoutBasic*Label.padX                5    interactive
  830.  
  831.     # Client area. This is where the caller places its widgets.
  832.     frame $wizState(widget,clientArea) -bd 8 -relief flat
  833.     frame $layout.sep1 -class WizSeparator -height 2 -bd 2 -relief groove
  834.  
  835.     # title and subtitle and icon
  836.     frame $layout.titleframe -bd 4 -relief flat -background white
  837.     label $wizState(widget,title) -background white -width 40
  838.     label $wizState(widget,subtitle) -height 2 -background white -padx 15   -width 40
  839.     label $wizState(widget,icon) \
  840.         -borderwidth 0 \
  841.         -image [namespace current]::feather \
  842.         -background white \
  843.         -anchor c
  844.     set labelfont [font actual [$wizState(widget,title) cget -font]]
  845.     $wizState(widget,title) configure -font [concat $labelfont -weight bold]
  846.  
  847.     # put the title, subtitle and icon inside the frame we've
  848.     # built for them
  849.     set tf $layout.titleframe
  850.     grid $wizState(widget,title)    -in $tf -row 0 -column 0 -sticky nsew
  851.     grid $wizState(widget,subtitle) -in $tf -row 1 -column 0 -sticky nsew
  852.     grid $wizState(widget,icon)     -in $tf -row 0 -column 1 -rowspan 2 -padx 8
  853.     grid columnconfigure $tf 0 -weight 1
  854.     grid columnconfigure $tf 1 -weight 0
  855.  
  856.     # pre and post text. We'll pick rough estimates on the size of these
  857.     # areas. I noticed that if I didn't give it a width and height and a
  858.     # step defined a really, really long string, the label would try to
  859.     # accomodate the longest string possible, making the widget unnaturally
  860.     # wide.
  861.  
  862.     label $wizState(widget,pretext)  -width 40 
  863.     label $wizState(widget,posttext) -width 40
  864.  
  865.     # when our label widgets change size we want to reset the
  866.     # wraplength to that same size.
  867.     foreach widget {title subtitle pretext posttext} {
  868.         bind $wizState(widget,$widget) <Configure> {
  869.             # yeah, I know this looks weird having two after idle's, but
  870.             # it helps prevent the geometry manager getting into a tight
  871.             # loop under certain circumstances
  872.             #
  873.             # note that subtracting 10 is just a somewhat arbitrary number
  874.             # to provide a little padding...
  875.             after idle {after idle {%W configure -wraplength [expr {%w -10}]}}
  876.         }
  877.     }
  878.  
  879.     grid $layout.titleframe            -row 0 -column 0 -sticky nsew -padx 0
  880. #    grid $wizState(widget,title)      -row 0 -column 0 -sticky nsew -padx 0
  881. #    grid $wizState(widget,subtitle)   -row 1 -column 0 -sticky nsew -padx 0
  882. #    grid $wizState(widget,icon)       -row 0 -column 1 -rowspan 2 -sticky nsew -ipadx 10 -ipady 4
  883.     grid $layout.sep1                 -row 1 -sticky ew 
  884.     grid $wizState(widget,pretext)    -row 2 -sticky nsew -pady 8 -padx 8
  885.     grid $wizState(widget,clientArea) -row 3 -sticky nsew -padx 8 -pady 8
  886.     grid $wizState(widget,posttext)   -row 4 -sticky nsew -pady 8 -pady 8
  887.  
  888.     grid columnconfigure $layout 0 -weight 1
  889.     grid rowconfigure $layout 0 -weight 0
  890.     grid rowconfigure $layout 1 -weight 0
  891.     grid rowconfigure $layout 2 -weight 0
  892.     grid rowconfigure $layout 3 -weight 1
  893.     grid rowconfigure $layout 4 -weight 0
  894.  
  895.     # the pre and post text will initially not be visible. They will pop into
  896.     # existence if they are configured to have a value
  897.     grid remove $wizState(widget,pretext) $wizState(widget,posttext)
  898.  
  899. }
  900.  
  901. # usage: configureLayout-basic ?-title string? ?-subtitle string? ?-icon image?
  902. proc tkwizard::configureLayout-basic {name args} {
  903.     upvar #0 [namespace current]::@$name-state wizState
  904.     upvar #0 [namespace current]::@$name-config wizConfig
  905.  
  906.     if {[llength $args]%2 == 1} {
  907.         return -code error "wrong number of args..."
  908.     }
  909.  
  910.     foreach {option value} $args {
  911.         switch -- $option {
  912.             -title {
  913.                 $wizState(widget,title) configure -text "$value"
  914.             }
  915.  
  916.             -subtitle {
  917.                 $wizState(widget,subtitle) configure -text $value
  918.             }
  919.  
  920.             -icon {
  921.                 $wizState(widget,icon) configure -image $value
  922.             }
  923.  
  924.             -pretext {
  925.                 $wizState(widget,pretext) configure -text $value
  926.                 if {[string length $value] > 0} {
  927.                     grid $wizState(widget,pretext)
  928.  
  929.                 } else {
  930.                     grid remove $wizState(widget,pretext)
  931.                 }
  932.             }
  933.  
  934.             -posttext {
  935.                 $wizState(widget,posttext) configure -text $value
  936.                 if {[string length $value] > 0} {
  937.                     grid $wizState(widget,posttext)
  938.                 } else {
  939.                     grid remove $wizState(widget,posttext)
  940.                 }
  941.             }
  942.  
  943.             default {
  944.                 return -code error "unknown option \"$option\""
  945.             }
  946.         }
  947.     }
  948. }
  949.  
  950. ######
  951. # "Advanced" layout. Nothing really advanced about it, but that's what
  952. # microsoft seems to call wizards that look like this. Go figure.
  953. ######
  954.  
  955. proc tkwizard::initLayout-advanced {name} {
  956.     upvar #0 [namespace current]::@$name-state wizState
  957.     upvar #0 [namespace current]::@$name-config wizConfig
  958.  
  959.     set layout $wizState(widget,layoutFrame).advanced
  960.  
  961.     set wizState(widget,clientArea)   $layout.clientArea
  962.     set wizState(widget,icon)         $layout.icon
  963.     set wizState(widget,title)        $layout.title
  964.     set wizState(widget,subtitle)     $layout.subtitle
  965.     set wizState(widget,pretext)      $layout.pretext
  966.     set wizState(widget,posttext)     $layout.posttext
  967. }
  968.  
  969. proc tkwizard::buildLayout-advanced {name} {
  970.     upvar #0 [namespace current]::@$name-state wizState
  971.     upvar #0 [namespace current]::@$name-config wizConfig
  972.  
  973.     set layout $wizState(widget,layoutFrame).advanced
  974.  
  975.     frame $layout -class WizLayoutAdvanced
  976.  
  977.     # using the option database saves me from hard-coding it for
  978.     # every widget. I guess I'm just lazy.
  979.     option add *WizLayoutAdvanced*Label.justify             left interactive
  980.     option add *WizLayoutAdvanced*Label.anchor              nw   interactive
  981.     option add *WizLayoutAdvanced*Label.highlightThickness  0    interactive
  982.     option add *WizLayoutAdvanced*Label.borderWidth         0    interactive
  983.     option add *WizLayoutAdvanced*Label.padX                5    interactive
  984.  
  985.     # Client area. This is where the caller places its widgets.
  986.     frame $wizState(widget,clientArea) -bd 8 -relief flat
  987.     frame $layout.sep1 -class WizSeparator -height 2 -bd 2 -relief groove
  988.  
  989.     # title and subtitle
  990.     label $wizState(widget,title)
  991.     label $wizState(widget,subtitle) -height 2
  992.     array set labelfont [font actual [$wizState(widget,title) cget -font]]
  993.     set labelfont(-weight) bold
  994.     incr labelfont(-size) 6
  995.     $wizState(widget,title) configure -font [array get labelfont]
  996.  
  997.     # pre and post text. 
  998.     label $wizState(widget,pretext)
  999.     label $wizState(widget,posttext)
  1000.  
  1001.     # when our label widgets change size we want to reset the
  1002.     # wraplength to that same size.
  1003.     foreach widget {title subtitle pretext posttext} {
  1004.         bind $wizState(widget,$widget) <Configure> {
  1005.             # yeah, I know this looks weird having two after idle's, but
  1006.             # it helps prevent the geometry manager getting into a tight
  1007.             # loop under certain circumstances
  1008.             #
  1009.             # note that subtracting 10 is just a somewhat arbitrary number
  1010.             # to provide a little padding...
  1011.             after idle {after idle {%W configure -wraplength [expr {%w -10}]}}
  1012.         }
  1013.     }
  1014.  
  1015.     # icon
  1016.     label $wizState(widget,icon) \
  1017.         -borderwidth 1 \
  1018.         -relief sunken \
  1019.         -image [namespace current]::feather \
  1020.         -background white \
  1021.         -anchor c \
  1022.         -width 96
  1023.  
  1024.     grid $wizState(widget,icon)       -row 0 -column 0 -rowspan 5 -sticky nsew -pady 8 -padx 8
  1025.     grid $wizState(widget,title)      -row 0 -column 1 -sticky ew -pady 8  -padx 8
  1026.     grid $wizState(widget,subtitle)   -row 1 -column 1 -sticky ew -pady 8 -padx 8
  1027.     grid $wizState(widget,pretext)    -row 2 -column 1 -sticky ew -padx 8
  1028.     grid $wizState(widget,clientArea) -row 3 -column 1 -sticky nsew -padx 8
  1029.     grid $wizState(widget,posttext)   -row 4 -column 1 -sticky ew -padx 8 -pady 24
  1030.  
  1031.     grid columnconfigure $layout 0 -weight 0
  1032.     grid columnconfigure $layout 1 -weight 1
  1033.  
  1034.     grid rowconfigure $layout 0 -weight 0
  1035.     grid rowconfigure $layout 1 -weight 0
  1036.     grid rowconfigure $layout 2 -weight 0
  1037.     grid rowconfigure $layout 3 -weight 1
  1038.     grid rowconfigure $layout 4 -weight 0
  1039.  
  1040.     # the pre and post text will initially not be visible. They will pop into
  1041.     # existence if they are configured to have a value
  1042.     grid remove $wizState(widget,pretext) $wizState(widget,posttext)
  1043. }
  1044.  
  1045. proc tkwizard::configureLayout-advanced {name args} {
  1046.     upvar #0 [namespace current]::@$name-state wizState
  1047.     upvar #0 [namespace current]::@$name-config wizConfig
  1048.  
  1049.     if {[llength $args]%2 == 1} {
  1050.         return -code error "wrong number of args..."
  1051.     }
  1052.  
  1053.     foreach {option value} $args {
  1054.         switch -- $option {
  1055.             -title {
  1056.                 $wizState(widget,title) configure -text $value
  1057.             }
  1058.  
  1059.             -subtitle {
  1060.                 $wizState(widget,subtitle) configure -text $value
  1061.             }
  1062.  
  1063.             -icon {
  1064.                 $wizState(widget,icon) configure -image $value
  1065.             }
  1066.  
  1067.             -pretext {
  1068.                 $wizState(widget,pretext) configure -text $value
  1069.                 if {[string length $value] > 0} {
  1070.                     grid $wizState(widget,pretext)
  1071.                 } else {
  1072.                     grid remove $wizState(widget,pretext)
  1073.                 }
  1074.             }
  1075.  
  1076.             -posttext {
  1077.                 $wizState(widget,posttext) configure -text $value
  1078.                 if {[string length $value] > 0} {
  1079.                     grid $wizState(widget,posttext)
  1080.                 } else {
  1081.                     grid remove $wizState(widget,posttext)
  1082.                 }
  1083.             }
  1084.  
  1085.             default {
  1086.                 return -code error "unknown option \"$option\""
  1087.             }
  1088.         }
  1089.     }
  1090. }
  1091.  
  1092.